OPTIONAL FIXEDPOINT

include ..\Float-tools
include ..\Forth-Tools

Only Forth Definitions

{ ====================================================================================
   Bit Format: 16.16

   If * or / are used, the parameters can be as follows: ( fixed int -- fixed )
====================================================================================== }

\ Conversion
\ =====================================================================================


65536e fvalue 65536e  \ makes fixed point conversion 1.33x faster
1e 65536e f/ fvalue 1/65536e
icode s>p
   EBX 16 # SHL
   ret end-code

icode p>s
   EBX 16 # SAR
   ret end-code

: p>f   s>f 1/65536e f* ;
: f>p   65536e f* f>s ;

\ Math
\ =====================================================================================

pi f>p constant ppi
pi/2 f>p constant ppi/2.
pi/180 f>p constant ppi/180.
180e pi f/ f>p constant 180/ppi

\ : p*   65536 */ ;
\ 4x faster
icode p*
  ebx eax mov
  0 [ebp] imul
  4 # ebp add
  dx ax mov
  eax 16 # ror
  eax ebx mov
  ret end-code

: p/   65536 swap */ ;
{  \ this was not any faster.
icode p/
  0 [ebp] eax mov
  eax 16 # ror
  ax dx movsx
  $ffff0000 # eax and
  ebx idiv
  4 # ebp add
  eax ebx mov
  ret end-code
}

: pcos   p>f fCOS f>p ;
: psin   p>f fSIN f>p ;
: pd>r   ppi/180. p* ;
: pr>d   180/ppi p* ;

: sins,   65536 0 do i 411480 65536 */ psin 65537 p* dup 0> if 1 + then , loop ;
create sintbl sins,
:macro psin   360.0 p/ 65535 and cells sintbl + @ ;
:macro pcos   360.0 p/ 16384 + 65535 and cells sintbl + @ ;

: lerp   ( src dest n. -- )
   >r over - r> p* + ;

:macro p+    + ;
:macro p-    - ;
:macro .SQRT   p>f fsqrt f>p ;


\ Printing
\ =====================================================================================

: >int  $ffff0000 and ;
: int.    p>s . ;
: p.    p>f f. ;
: .?    @ p. ;
: 2p.    swap p. p. ;
: 3p.    rot p. swap p. p. ;

\ Extend literal interpreter/compiler
\ =====================================================================================

VARIABLE .sign
: .FCONVERT ( a -- 0 | a -1 ) ( -- | r )
   <SIGN>    ( a c f)  DROP [CHAR] - = .sign !
   <DIGITS>  ( a d n)  0= IF 2DROP DROP 0 EXIT THEN D>F
   <DOT>     ( a c f)  0= IF FDROP 2DROP 0 EXIT THEN DROP
   <DIGITS>  ( a d n)  -ROT D>F T10** F/ F+
                       .sign @ IF FNEGATE THEN
   <E>       ( a c f)  IF FDROP 2DROP 0 EXIT THEN DROP
   -1 ;

: >.FLOAT ( caddr n -- true | false ) ( -- r )
   R-BUF  R@ ZPLACE  R@ .FCONVERT ( 0 | a\f ) IF
      R> ZCOUNT + = DUP ?EXIT FDROP EXIT
   THEN R> DROP 0 ;

: .NUMBER? ( addr len 0 | p.. xt -- addr len 0 | p.. xt )
     DUP IF EXIT THEN
     DROP
     BASE @ 10 = IF
          2DUP >.FLOAT IF 2DROP
               65536e ( 4096e ) f* f>s ['] LITERAL  EXIT THEN
     THEN   0 ;

' .NUMBER? NUMBER-CONVERSION >CHAIN

\ Multiple stack item conversions
\ =====================================================================================

{
: 2s>p   s>p swap s>p swap ;
: 2p>s   p>s swap p>s swap ;
}

icode 2s>p
   ebx 16 # shl
   0 [ebp] 16 # shl
   ret end-code

icode 2p>s
   ebx 16 # sar
   0 [ebp] 16 # sar
   ret end-code

{
: 3s>p   >r 2s>p r> s>p ;
: 3p>s   >r 2p>s r> p>s ;
}

icode 3s>p
   ebx 16 # shl
   0 [ebp] 16 # shl
   4 [ebp] 16 # shl
   ret end-code

icode 3p>s
   ebx 16 # sar
   0 [ebp] 16 # sar
   4 [ebp] 16 # sar
   ret end-code


: 2p>f   swap p>f p>f ;
: 3p>f   >r >r p>f r> p>f r> p>f ;
: 4p>f   >r >r swap p>f p>f r> p>f r> p>f  ;




\ Ellipse math

: ellipse-perimeter  ( radiusx. radiusy. -- n. )
  2dup + 3.0 p*
  -rot
  2dup 3.0 p* +
  -rot
  swap 3.0 p* + p*
  .sqrt - ppi p* ;

: ellipse-area  ( radiusx. radiusy. -- n. )
  ppi p* p* ;

: ellipse-point  ( radiusx. radiusy. degree. -- x. y. )
  locals| degrees radiusy radiusx |
    degrees pcos radiusx p*
    degrees psin radiusy p* ;

: within-ellipse?  ( x. y. radiusx. radiusy. -- flag )
  rot swap p/ dup p*
  -rot p/ dup p* + 1.0 < ;

\ Circle math

: circle-area   ( radius. -- n. )
  dup ellipse-area ;

: circle-perimeter  ( radius. -- n. )
  ppi p* dup p+ ;

: circle-point  ( radiusx. degree. -- x. y. )
  >r dup r> ellipse-point ;

: within-circle?  ( x. y. radius. -- flag )
    dup within-ellipse? ;


int extend: fixed end-type

: fixed.?  p. ;


